unit iconcache;

interface

uses
  Windows, SysUtils, Classes, Graphics, MyUtils, ShellAPI, MyMd5;

type
  TIconDB = class
  private
    ficons:TStringList;
    FDefault:TIcon;
    function GetIcon(obj: string): TIcon;
    function GetDefaultIcon: TIcon;
    procedure SetDefaultIcon(const Value: TIcon);
  public
    constructor Create();
    destructor Destroy(); override;
    property icon[obj:string]:TIcon read GetIcon;
    property DefaultIcon:TIcon read GetDefaultIcon write SetDefaultIcon;
    procedure Clear();
    function GetIconIcon(FileName: TFileName; ICON_Flag:Cardinal = SHGFI_SMALLICON): TIcon;
    procedure dbg_dump(const dir:string);
  end;

implementation


{ TIconDB }

procedure TIconDB.Clear;
var
  i:Integer;
begin
  for i:=0 to ficons.Count-1 do
    TIcon(ficons.Objects[i]).Free;
  ficons.Clear;
end;

constructor TIconDB.Create;
begin
  ficons:=TStringList.Create;
  FDefault := nil;
end;

procedure TIconDB.dbg_dump(const dir: string);
var
  i:Integer;
begin
  CreateDir(dir);
  for i:=0 to ficons.Count-1 do
    if ficons.Objects[i] <> nil then
      TIcon(ficons.Objects[i]).SaveToFile(dir + '\' + ficons[i] + '.ico');
end;

destructor TIconDB.Destroy;
begin
  Clear();
  ficons.Free;
  if Assigned(FDefault) then
    FDefault.Free;
end;

function TIconDB.GetDefaultIcon: TIcon;
begin
  if FDefault = nil then
    begin
      FDefault := TIcon.Create();
    end;
  Result := FDefault;
end;

function TIconDB.GetIcon(obj: string): TIcon;
var
  i:integer;
  s:string;

  function find(const tp:string):integer;
  begin
    result := ficons.IndexOf(tp);
  end;

begin
  Result := DefaultIcon;
  if obj = '' then
    exit;
  s := obj[length(obj)];
  if s = '\' then
    begin
      i := find('\');
      if i = -1 then
        begin
          Result := GeticonIcon(obj);
          ficons.AddObject('\', Result);
        end
      else
        begin
          Result := TIcon(ficons.Objects[i]);
        end;
    end
  else
    begin
      s := LowerCase(ExtractFileExt(obj));
      if s = '' then
        exit;
      i := ficons.IndexOf(s);
      if i = -1 then
        begin
          Result := GeticonIcon(obj);
          ficons.AddObject(s, Result);
        end
      else
        begin
          Result := TIcon(ficons.Objects[i]);
        end;
    end;
  if not Assigned(result) then
      Result := DefaultIcon;
end;

function TIconDB.GetIconIcon(FileName: TFileName;
  ICON_Flag: Cardinal): TIcon;
var
    FileInfo: TSHFileInfo;
begin
  FillChar(FileInfo, SizeOf(FileInfo), #0);
  if SHGetFileInfo(PChar(FSlash(FileName)), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or ICON_FLAG) <> 0 then
    begin
       Result := TIcon.Create;
       Result.Handle :=FileInfo.hIcon;
    end
  else
    Result := nil;
end;

procedure TIconDB.SetDefaultIcon(const Value: TIcon);
begin
  if not Assigned(FDefault) then
    FDefault := TIcon.Create;
  FDefault.Assign(Value);
end;



end.
